home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Utilities / Miscellaneous / CopyPaste 3.3.4 / CopyPaste Tools Sourcecode / Time / Time.p < prev    next >
Encoding:
Text File  |  1997-06-06  |  1.5 KB  |  66 lines  |  [TEXT/CWIE]
  1. {•This sourcecode is an example for creating a FKey coderesource with•}
  2. {•Metrowerks Pascal. It is copyrighted by Peter Hoerster and released•}
  3. {•for free use in any Shareware or Freeware product as a way to thank all•}
  4. {•programmers who share code snippets. You may put this sources on any•}
  5. {•CD ROM or any Archive Server but you may not sell it. •}
  6.  
  7. {• For comments please write to <hoerster@muenster.de>•}
  8.  
  9. unit Time;
  10.  
  11. interface
  12.  
  13.     uses
  14.         Types, OSUtils, GestaltEqu, Script, notification, Resources, Events,
  15.          PascalA4, QuickDraw, ToolUtils, Memory, LowMem, Scrap;
  16.  
  17.  
  18.  
  19. {$MAIN}
  20.                         
  21.     procedure main;        
  22.  
  23. implementation
  24.  
  25.     procedure dopaste;
  26.     const
  27.         pastecode=2422;
  28.     var 
  29.         qel: EvQelPtr;
  30.     begin
  31.             if ppostevent(3, pastecode, qel) = noerr then
  32.             qel^.evtqmodifiers := cmdkey;
  33.     end;
  34.  
  35.  
  36.     procedure main;
  37.         var
  38.             oldA4: LongInt;
  39.             myerr: oserr;
  40.             myclipsize, templongint: longint;
  41.             myclipHandle: handle;
  42.             infostring: str255;
  43.  
  44.             
  45.     begin
  46.         oldA4 := SetCurrentA4;
  47.         GetDateTime(templongint);
  48.         IUTimeString(templongint, false, infostring);
  49.         myclipsize:=length(infostring);
  50.         mycliphandle := Tempnewhandle(myclipsize,myerr);
  51.         if myerr=noerr then 
  52.             begin
  53.                 Temphlock(mycliphandle,myerr);
  54.                 if myerr=noerr then 
  55.                     begin
  56.                         blockmove(@infostring[1], mycliphandle^, myclipsize);
  57.                         myerr := ZeroScrap;
  58.                         myerr := putscrap(myclipsize, 'TEXT', myclipHandle^);
  59.                         dopaste;
  60.                     end;
  61.                 Temphunlock(myCliphandle,myerr);
  62.             end;
  63.         TempDisposeHandle(myCliphandle,myerr);
  64.         oldA4 := SetA4(oldA4);
  65.     end;
  66. end.